Optional Vbufs.f

{ In the future this module will have fallback for cards without vertex buffer support. }

Requires Structs
Requires Tools
Requires Quotations
Requires Linked-lists
Requires GL-Tools
Requires Kagi
Requires SORA\Buffers
Requires SORA\Vertices

Only Forth Definitions

\ /Buffer Inherit
Struct
   cell+

   cell field ->vbo
   cell field ->vcount
   cell field ->ptype
   cell field ->vtype
End-struct /Vbuf

Variable vbufs

: vbuf,  ( vertex-type gl-primitive -- )
   here >r /Vbuf /allot
   r@ ->ptype !
   r@ ->vtype !
   r> dup vbufs add-link ;

: Vbuf: ( vertex-type gl-primitive -- <name> )
  create vbuf,  ;

: vbuf-begin  ( count vbuf -- )
   2dup ->vcount !
   dup ->vtype @ vtype>size rot * swap
   ->vbo @ map-vbo  to vpointer
; \   vpointer mem ;

: vbuf-end
   unmap-vbo ;

:macro (vertices)  >r vbuf-begin r> execute vbuf-end ;

:[] vertices:[   ( count vbuf xt -- )  ( -- )
   (vertices) ;

: bind-vbuf   ( vbuf -- )  ->vbo @ bind-vbo ;

: draw-some   ( vbuf index count -- )
   third bind-vbuf
   third ->vtype @ 0 set-vertex-pointers
   rot  ->ptype @  -rot glDrawArrays ;

: draw  ( vbuf -- )
   0 over ->vcount @ draw-some ;

 :[] draw:[   ( count vbuf xt -- )  ( -- )
   over >q     (vertices)    q> draw  ;

: init-vbuf  ( vbuf -- )
   glGenBuffersARB( 1 swap ->vbo ) ;

: init-vbufs
   vbufs follow:[ init-vbuf ;] ;

\ :prune   vbufs traverse ;
\ :onload   init-vbufs ;
\ :onexit   vertex-buffers free-buffers ;


: quad2d ( u1 v1 u2 v2 z x1 y1 x2 y2 -- )
  locals| y2 x2 y1 x1 z v2 u2 v1 u1 |
     u1 v1 tcoord x1 y1 z Vertex2D
     u1 v2 tcoord x1 y2 z Vertex2D
     u2 v2 tcoord x2 y2 z Vertex2D
     u2 v1 tcoord x2 y1 z Vertex2D ;

: transformed-quad2d  ( u1 v1 u2 v2 z x1 y1 x2 y2 transform -- )
  locals| t y2 x2 y1 x1 z v2 u2 v1 u1 |
     u1 v1 tcoord x1 y1 t 2transform z Vertex2D
     u1 v2 tcoord x1 y2 t 2transform z Vertex2D
     u2 v2 tcoord x2 y2 t 2transform z Vertex2D
     u2 v1 tcoord x2 y1 t 2transform z Vertex2D ;

{
: transformed-quad2d ( u1 v1 u2 v2 z x1 y1 x2 y2 transform -- )
  locals| t y2 x2 y1 x1 z v2 u2 v1 u1 |
     u1 v1 tcoord x1 y1 t 2transform z Vertex2D
     u1 v2 tcoord x1 y2 t 2transform z Vertex2D
     u2 v2 tcoord x2 y2 t 2transform z Vertex2D
     u2 v1 tcoord x2 y1 t 2transform z Vertex2D ;
}
